\ Handles Mops user interface.

syscall OpenRF
syscall FSClose
syscall HCreateResFile
syscall CloseResFile
syscall CurResFile
syscall HOpenResFile


// alert

	string	IMAGENAME			\ Current Mops dictionary image name
	string	APPL_NAME			\ Default appl name for Install
	string	APPL_VERS			\ Ditto version string
0	value	APPL_SIG			\ Ditto signature


\ MOPS_OBJECTS sets up system objects for the Mops development environment.
\ We put it first so that we can tick the exported versions of some words,
\ which have to be referred to by vectors or x-arrays (since a module can
\ only be invoked through an exported word).

\ Note: the various things we do below in setting up fWind can't be done
\ by SysInit, since under System 7 fWind doesn't exist until a dictionary
\ is read in, which is later than SysInit time.  But for an installed
\ application which uses fWind, this module won't exist, so we have a
\ separate initialization word AppInit (in file ObjInit) which is called
\ by ObjInit for an installed application.  fWind will then be available
\ from the start, so AppInit does the setting up.


: MOPS_OBJECTS  { \ left top right bottom -- }
	['] (about)  -> aboutVec
	fWind?
	IF	classinit: fWind   markalive: fWind
		['] enFW  ['] disFW		setAct: fWind
		myDoc 2dup  title: fWind  put: imageName
		ScreenBits  -> bottom  -> right  -> top  -> left
		70 70 right bottom  true  setGrow: fWind
		setContRect: fWind
	THEN  ;


\		=========== Menu handlers ===========


1 alert	ABTALRT		' null 1  put: abtAlrt
1 alert	nimplAlrt	' null 1  put: nimplAlrt


variable	VERSION		40 allot

: (ABOUT)
	50 getString  version  place
	0 0  version count  0 0  0 0  paramText
	128 16  disp: abtAlrt  ;

: xNIMPL
	129 cautionAlert  disp: NimplAlrt  ;


\		=============== File Menu ===============

    0	value	CURRVREF
false	value	SAVED?		\ True if dic image saved at least once
    0	value	SAVE_RC		\ I/O return code from dic save
    variable	fRefNum


: .SAVED
	type# 101 ( Saved: )  getname: ffcb  type  cr  ;


: SAVEDIC  { \ fRefNum -- }
	get: imageName  name: fFcb  currVref  setVref: fFcb
	
\ now we can't just use  create: ffcb, since that method just opens the
\  file if it already exists, and when we try to write the resources we'll
\  get an error since they're there already.  We have to actually delete
\  the file in this situation.

	open: ffcb
	NIF			\ no error - i.e. it exists
		close: ffcb drop
		delete: ffcb  OK?
	THEN
	create: ffcb  OK?
	'type APPL  'type MOPP  set: ffcb
	currVRef  0  get: imageName str255  HCreateResFile  drop resChk
	currVref  0  buf255  0  HOpenResFile  -> fRefNum  resChk
	get: imageName  32 min  myDocName place
	true  false  (wp)		\ true = res fork open, false = not installing
	fRefNum  CloseResFile  resChk
	close: ffcb  drop
	true -> saved?  .saved
;
	

: STDSAVE		\ save via stdFile
	" Save Mops image as:"  saved? IF  get: imagename  ELSE  myDoc  THEN
	stdPut: fFcb
	IF
		getVref: fFcb  -> currVref
		getName: fFcb  put: imageName
		saveDic
	THEN  ;

: DOSAVE		\ Resave current dictionary.
	saved?
	IF		saveDic
	ELSE	stdSave
	THEN  ;


: PSETUP		\ page setup
	nimpl  ;


\		============= List Menu ===============

: doOlist	nimpl  ;
: doClist	nimpl  ;


\		============= Show Menu ===============

: x.ROOM
	cr
	." Room in data area of dictionary:               "  room2		7 .r cr
	." Room in code area of dictionary:               " 			7 .r cr
	." Distance to top of mainData range (neg is OK): "
							mainData half_displ_range +  DP -		7 .r cr
	." Distance to top of mainCode range:             "  headroom	7 .r cr
	." Total heap (no purge):                         "  free		7 .r  cr
	." Largest block (purge):                         "  freeblk	7 .r  cr
;

\		============= Utilities Menu ===============


: CHKUTIL	\ ( item# b -- ) check item if boolean is true
	IF		check: utilMen
	ELSE	unCheck: utilMen
	THEN  ;

\ false	value	PRECHO?  \ 31Jan94 DBH

\ : ?UTILFLGS	1 echo? chkUtil  0 prEcho? chkUtil  ;
: ?UTILFLGS		0 echo? chkUtil ;  \ 31Jan94 DBH


: LECHO		\ Toggles echo during loads
	echo? not -> echo?  ?utilFlgs  ;


: DOPURGE  ;



: DISFW
	false -> fWindActive?  ;

: ENFW
	true -> fWindActive?  ;

: NMENU
	xts{  null null null null null null null null null  }
														3  init: EditMen
			\ this gets properly initialized in TEFwindMod

	getnew: AppleMen  getnew: FileMen  getnew: EditMen
	getnew: ListMen  getnew: ShowMen  getnew: UtilMen
	AppleMen FileMen EditMen ListMen ShowMen UtilMen	6  init: MenuBar
	?utilFlgs
;

(* *****
\				============= Edit Menu ===============

\ Note: the Edit Menu stuff MUST COME AFTER the definition of Nmenu.  This
\ is because we must set up the menu with the EXPORTED versions of the
\ words doUndo etc.  Because we haven't defined these words here in the module
\ yet, only the exported versions are visible from Nmenu, which is what we
\ want.


\ Scrap support

	string	PARMSTR
	var		THEOFFSET
	handle	SCRAPHDL

: DoUndo	nimpl  ;
: doCut		nimpl  ;
: doCopy	nimpl  ;
: doClear	nimpl  ;
: doSelAll	nimpl  ;


: get_scrap		\ ( -- len )
	0 0 put: parmStr  handle: parmStr  put: scrapHdl
	get: scrapHdl  'type TEXT  addr: theOffset
	GetScrap
	setSize: parmStr  lock: parmStr  len: parmStr  ;

: SCRAPKEY	\ Gets next char from the scrap

	len: parmStr
	NIF  key!  13  EXIT  THEN		\ Simulate a terminal CR
	1st: parmStr  1 skip: parmStr  ;


: DOPASTE		\ Interprets from the scrap
	get_scrap 0<=  ?EXIT
	false -> relocChk?  ['] scrapKey -> key  true -> relocChk?
	sp0 sp!  quit  ;

**** *)

: xPref		nimpl  ;


\ The following words are called by Install to get and set the default name, version and signature for the current application.  They are initialized to the Mops values, but may be changed at any time.  Note that the first two of these words return a string object, rather than an addr and a length.  This was simpler for Install, and they shouldn't be getting called from anywhere else.

: GET_APPL_NAME		appl_name  ;
: GET_APPL_VERS		appl_vers  ;
: GET_APPL_SIG		appl_sig  ;

: SET_APPL_NAME		put: appl_name  ;
: SET_APPL_VERS		put: appl_vers  ;
: SET_APPL_SIG		-> appl_sig  ;

\ system startup word:

: RUN_FE
	mops_objects  openMR  nMenu
	" mops.paths"	getPaths
	" Mops"			put: appl_name
	50 getString	put: appl_vers
	'type MOPS	-> appl_sig
	20 -> sleepticks
	run_TE
;


: (REL)
	release: imageName  ;

' (rel)  setrelease